00100	C 2/18/83  ******** SUBROUTINE JUSTFY, FUNCTION OTHSID *************
00200		SUBROUTINE JUSTFY(JLP,ITEM,NPW,NO,RN,RSTFAC,R2,R4,R5)
00300	CX	SUBROUTINE JUSTFY(JLP,R,IR,NO,NP,RN,RSTFAC,R2,R4,R5,R6,R8,R9)
00400	COPYRIGHT 1983 BY LELAND SMITH
00500		COMMON/RINP/XPS(900),XPR(300)
00600		COMMON /JST/ N,XP(300),XPL(300)
00700		DIMENSION RN(1),NO(1),RSTFAC(0/1),NPW(1)
00800	C JLP= TOP STAFF NUM.
00900	C R2=THIS STAFF NUM.  R4=LEFT EDGE, R5=RIGHT EDGE.
01000	
01100		RJLP=JLP
01200		N=1
01300		DO 200 K=1,ITEM
01400		L=NPW(K)
01500		RL=RN(L)
01600	C  RL=WDCNT-2
01700		RA=RN(L+1)
01800	C  RA=CODE NUM.
01900		RR3=RN(L+3)
02000	C  RR3=POSITION(P3)
02100		IF(RR3+0.1.LT.R4.OR.RR3.GT.R5)GO TO 200
02200	C JUMP IF ITEM NOT IN BOUNDS
02300		IF(RA.GT.4.0.AND.RA.LT.17.0)GO TO 200
02400	C LOOKS AT NOTES, RESTS, CLEFS, BARS, KSIG, METER
02500		RR2=RN(L+2)
02600	C  RR2=STAFF NUM. OF THIS ITEM
02700		IF(RR2.NE.R2.AND.R2.LE.RJLP)GO TO 200
02800	C  THIS STAFF? OR LOOK AT ALL STAVES.
02900		RY=1.
03000	C BASIC SIZE FACTOR
03100		PL=0
03200		RR5=RN(L+5)
03300	C  RR5=PARAM 5    RR6=P6   RW=P4 
03400		RR6=RN(L+6)
03500	78	RR4=RN(L+4)
03600	C  RR4=HEIGHT-MINI(P4)
03700		M=RA
03800		GO TO(1,2,3,4)M     
03900	C  LOOKS AT NOTES,RESTS,CLEFS,BAR LINES,KSIGS,METERS.
04000	
04100		IF(M.EQ.18)GO TO 18
04200		GO TO 17
04300	
04400	C***** NOTES ******
04500	1	IF(RL.GE.7.0.AND.RN(L+9).LT.0)GO TO 200
04600	C  IF P9<0 IGNORE THIS NOTE.
04700		RR7=RN(L+7)
04800	C RR7=P7  DOTS, TAILS
04900		RC=ABS(RR4)
05000		RR4=AMOD(RR4,100.0)
05100		IF(RR4.GT.80.0)RR4=RR4-100.0
05200		IF(RC.LT.80.)GO TO 19
05300		IF(RC.LT.180.)RY=.6
05400	C  FOUND A MINI-NOTE
05500	
05600	CC19	PL=1.
05700	C SPACE NEEDED TO LEFT
05800	19	PR=3.5
05900	C SPACE NEEDED TO RIGHT
06000		PRR=0
06100	C STORES EXTRA SPACE TO RIGHT
06200		PLL=0
06300	C STORES EXTRA SPACE TO LFT
06400		
06500	CX	IF(RR4.LT.13.0.AND.RR4.GT.1.0)GO TO 10
06600	C IF LEDGER LINES ADD SPACE ON BOTH SIDES.
06700	CX	PR=4.0
06800	CX	PL=1.0
06900	10	IF(RR7.EQ.0)GO TO 12
07000	C TAIL ON NOTE?  (CHECK FOR HALF, WHOLE NOTES, RR6<0)
07100		RR=AMOD(RR7,10.0)
07200		IF(RR.LE.0.OR.RR6.LT.0)GO TO 11
07300		IF(RR5.LT.10.0.OR.RR5.GE.20.0)GO TO 11
07400	C SKIP IF NO STEM OR STEM DOWN
07500		PRR=1.5
07600	C ADD ROOM FOR TAIL
07700		
07800	11	KK=RR7/10
07900	CC	PX=2*KK
08000		PX=1.6*KK
08100	C SPACE FOR DOT(S)
08200		PX=PX+AMOD(RR7,1.0)*10.0
08300	C ADD SOME IF DOTS SPACED EXTRA TO RIGHT (E.G. 1.23=2.3 SPACES TO RT.)
08400		IF(PX.GT.PRR)PRR=PX
08500		IF(RR7.GE.10.0)GO TO 1012
08600	C NOTE HAS DOT, NO SPACE NEEDED FOR LEDGER LINE.
08700		IF(RR5.GE.10.0.AND.RR5.LT.20.0.AND.AMOD(RR7,10.0).GE.1.0)
08800		1 GO TO 1012
08900	C SKIP IF NOTE HAS TAIL ON STEM UP.
09000	12	 IF(PRR.GT.1.5)GO TO 1012
09100	C ALREADY ENOUGH SPACE FOR LEDGER LINE EXTENSION - SKIP NEXT
09200		JJ=0
09300	C NOW FIND NEXT CLOSEST NOTE TO RIGHT ON THIS STAFF.
09400		Z=10.0
09500		X=RR4-13.0
09600		DO 1000 M=1,ITEM
09700		J=NPW(M)
09800		IF(RN(J+1).NE.1.0)GO TO 1000
09900	C LOOK AT NOTES ONLY
10000		IF(RN(J+2).NE.RR2)GO TO 1000
10100	C THIS STAFF ONLY
10200		Y=RN(J+3)-RR3
10300		IF(Y.LE.0.OR.Y.GT.Z)GO TO 1000
10400		Z=Y
10500		JJ=J
10600	1000	CONTINUE
10700		IF(Z.GE.10.0)GO TO 1012
10800		IF(AMOD(RN(JJ+5),10.0).GE.1.0)GO TO 1012
10900	C SKIP IF NEXT NOTE HAS ACCI. IN FRONT.
11000		Z=AMOD(RN(JJ+4),100.0)
11100	C GET HEIGHT OF NOTE
11200		IF(X.GE.0)GO TO 1001
11300	C SKIP IF 1ST NOTE IS ABOVE STAFF 
11400		IF(Z.GE.1.0)GO TO 1002
11500		GO TO 1012
11600	1001	IF(Z.LT.13.0)GO TO 1012
11700	C SKIP IF NEXT NOTE BELOW STAFF
11800	1002	PRR=1.5
11900	C ADD 1. SO LEDGER LINES DON'T BUMP
12000	
12100	1012	RR=AMOD(RR5,10.0)
12200	C ANY ACCIDENTALS?
12300		IF(RR.EQ.0)GO TO 13
12400		PLL=3.0
12500		IF(IFIX(RR).EQ.5)PLL=5.0
12600	C RR=5 = DOUBLE FLAT
12700		PLL=PLL+AMOD(RR5,1.0)*10.0
12800	C INCREASE IF ACCI. SPACED TO LEFT. (E.G. 12.21 =2.1 SPACES TO LEFT)
12900	
13000	13	IF(RR6.EQ.0)GO TO 14
13100	C LOOK FOR HALF NOTES, WHOLE NOTES, NOTES ON WRONG SIDE OF STEM.
13200		KK=0
13300		IF(RR6.GT.0)GO TO 130
13400	C NOW IT'S A WHITE NOTE
13500		PR=3.9
13600	C 3.9=MINIMUM SPACE FOR HALFNOTE
13700		KK=IFIX(AMOD(RR7,10.0))
13800	C GET RT. DIGIT IN P7
13900		IF(KK.EQ.1)PR=4.3
14000		IF(KK.EQ.2)PR=4.8
14100	C =1=WHOLENOTE, =2=DOUBLE WHOLENOTE
14200		IF(RR6.GT.-10.0)GO TO 14
14300	C NOW NOTE ON WRONG SIDE OF STEM
14400	130	AR=2.5
14500		IF(KK.EQ.1)AR=3.0
14600		IF(KK.EQ.2)AR=3.5
14700		IF(ABS(RR6).GE.20.0)GO TO 135
14800	C NOW NOTE TO RIGHT OF STEM
14900		PRR=PRR+AR
15000		GO TO 14
15100	135	PLL=PLL+AR
15200	C ADD SPACE TO LEFT IF NOTE ON LEFT SIDE OF STEM
15300	
15400	14    	PR=(PR+PRR)*RY
15500		PL=(PL+PLL)*RY
15600		
15700		IF(RL.LT.8)GO TO 700
15800	C JUMP IF THERE IS NOT P10 TO LOOK AT
15900		RR2=RR2+1
16000	CC	RW=RN(L+10)
16100	C PUT P10 INTO RW
16200		IF(RN(L+10).GE.2.0)RR2=RR2-2.
16300	C NOW STAFF # IS SET TO WHERE NOTE REALLY IS.
16400		GO TO 700
16500	
16600	C***** RESTS *****
16700	2	IF(RL.GE.4.0.AND.RR6.LT.0)GO TO 200
16800		IF(RL.GE.5.0.AND.RR7.LT.0)GO TO 200
16900	C SKIP INVISIBILE RESTS AND RESTS WITH NEG. RHY.
17000		IF(RL.GE.6.0.AND.RR8.NE.0)GO TO 200
17100	C RR8<0=CENTERED WHOLE REST - ASSUMES NO NEED TO JUSTIFY.
17200		PR=3.0
17300		IF(RL.GE.5.0)PR=PR+RR6*2.0
17400	C RR6=DOTS
17500	CC	PL=1.0
17600		GO TO 700
17700		
17800	3	IF(RL.LT.3)GO TO 30
17900	C  <3 MEANS NOTHING IN R5
18000		IF(RR5.GT.4)GO TO 200
18100	C  NOT A REAL CLEF IF >4 (0=TREB, 1=BASS, 2=ALT, 3=TEN, 4=PERC.)
18200	30	IF(RL.GE.2.AND.RR4.GE.100.0)RY=.85
18300		PR=6.5*RY
18400		GO TO 700
18500	
18600	4	IF(RL.GT.3.OR.RR4.LT.0)GO TO 200
18700	C IF P4.LT.0 THEN IT'S AN INVISIBLE BAR.
18800	CC  FOR REPEAT BAR WDCNT IS 3 -- 10/77 444	IF(RL.GT.2)GO TO 2
18900	C  SHOULD CHECK ON BAR LINES NO MATTER WHICH STAFF
19000		PL=0.5
19100		PR=1.
19200	C PL=SPACE NEEDED TO LEFT, PR=SPACE NEEDED TO RIGHT, RR3=POS. OF ITEM
19300		KX=RR4/1000.
19400		IF(KX.LE.0.)GO TO 40
19500		PL=3.2
19600	C  ADD A LITTLE SPACE IN FRONT OF DBL BAR.
19700		IF(KX.EQ.2.OR.KX.EQ.4)PR=6.0
19800	C KX=2=DOTS TO RIGHT
19900		IF(KX.GT.2)PL=4.2
20000	C KX>2=DOTS TO LEFT
20100	CC	IF(RL.LT.3)GO TO 700
20200	C JUMP IF THIN DBL BAR. OLD DBL BAR HAS 1 IN R5.
20300	CC229	IF(KX.NE.2)PR=PR+PR
20400	C 2=DOTS TO RT. 1 OR 4=DOTS TO LFT. 3=DOTS ON BOTH SIDES.
20500	C  REPT BAR WITH DOTS TO LEFT.  ADD SPACE IN FRONT OF IT.
20600	CC	PL=-PL/RBX
20700	CC	IF(KX.EQ.4)KX=0
20800	CC129	IF(KX.GE.2)PL=RBZ*PL
20900	C  IF DOTS TO RIGHT ADD MORE SPACE AFTER REPT BAR.
21000		GO TO 700
21100	40	Z=999.
21200	C FIND NEXT CLOSEST ITEM.
21300		DO 41 M=1,ITEM
21400		J=NPW(M)
21500		IF(R2.LE.RJLP.AND.R2.NE.RN(J+2))GO TO 41
21600	C SKIP IF NOT ON RIGHT STAFF
21700		X=RN(J+3)
21800		IF(X.GT.Z.OR.X.LE.RR3)GO TO 41
21900		Z=RR3
22000		L=J
22100	C SAVE POS. AND CODE NUM.
22200	41	CONTINUE
22300		IF(RN(L+1).LE.2.0)PR=PR+1.5
22400	C IF A NOTE OR REST, ADD 1.5 TO SPACE
22500		GO TO 700
22600	
22700	C KSIG  
22800	17	RR5=ABS(RR5)
22900		IF(RR5.GE.100)RR5=RR5-100
23000	C  +100 FOR NATURALS AS KEYSIG.
23100		PR=0.5+2.1*(RR5-1)
23200	C  SPACES FOR CORRECT NUM OF ACCIS.  RR5=NUM OF ACCIS.
23300		PL=3.0
23400		GO TO 700
23500	
23600	C METER
23700	18	RC=0
23800		IF(RL.GE.7)RC=9
23900	C FOR COMPOSITE METERS. NO CHECK FOR DBL DIGITS YET.
24000		PR=3.5
24100		PL=1.0
24200		IF(RR6.LE.9.AND.RR5.LE.9)GO TO 180
24300	C  CHECKS FOR 2-DIGIT METERS
24400		PR=5.5
24500		PL=2.0
24600	180	PR=PR+RC
24700	700	CALL ROOM(RR3,PL,PR,RR2,R4,R5,RSTFAC)
24800	C    RR3=POS.,PL=NEED TO LEFT,PR=NEED TO RIGHT, RR2=STAFF#
24900	200	CONTINUE
25000		CALL JSORT(NO,R2,R4,R5,RN)
25100	300	END
25200	
25300		SUBROUTINE ROOM(RB,RL,RR,STAF,R4,R5,RSTFAC)
25400	C SETS UP ARRAYS CONTAINING ALL NEEDED SPACE INFO
25500		COMMON /RINP/PS(900),PR(300)
25600		COMMON /JST/ N,P(300),PL(300)
25700	C SHARE THESE ARRAYS WITH SOME OTHERS??? (RINP?)
25800		DIMENSION RSTFAC(0/1)
25900		P(N)=0
26000		PL(N)=0
26100		PR(N)=0
26200		PS(N)=-1
26300	C ZERO OUT NEXT ARRAY SLOTS
26400		IF(ABS(RB-R4).LE.0.1)RL=0
26500		IF(ABS(RB-R5).LE.0.1)RR=0
26600	CHECK TO SEE IF ITEM IS AT LEFT OR RIGHT EDGE OF JUSTIFY AREA.
26700		K=STAF
26800		S=RSTFAC(K)
26900	C GET PROPER SIZE FACTOR FOR THIS STAFF
27000		RL=RL*S
27100		RR=RR*S
27200		DO 1 K=1,N-1
27300		IF(ABS(RB-P(K)).GT.0.1)GO TO 1
27400	C SAME POSITION?
27500		IF(RB.LT.P(K))P(K)=RB
27600	C USE POSITION FARTHEST TO LEFT
27700		IF(STAF.NE.PS(K))GO TO 1
27800	C SAME STAFF?
27900		IF(PR(K).LT.RR)PR(K)=RR
28000		IF(PL(K).LT.RL)PL(K)=RL
28100	C ITEM IN SAME POS.  CHANGE SPACE REQUIREMENTS IF NECESSARY.
28200		RETURN
28300	1	CONTINUE
28400		P(N)=RB
28500		PR(N)=RR
28600		PL(N)=RL
28700		PS(N)=STAF
28800		N=N+1
28900	C PUT AWAY MORE SPACE NEEDS.
29000		END
29100	
29200		SUBROUTINE JSORT(NO,R2,R4,R5,RN)
29300		DIMENSION NO(1),RN(1)
29400		COMMON /RINP/PS(900),PR(300)
29500	C PS HAS 900 SO THERE IS ROOM FOR "NO" ARRAY (CHANGE THIS LATER?)
29600		COMMON /JST/ N,P(300),PL(300)
29700		P(N)=9999.
29800		N=N-1
29900		K=1
30000	2	A=P(K)
30100		M=K+1
30200		KK=K
30300		DO 1 L=M,N
30400		B=ABS(P(L)-A)
30500		IF(B.GT.0.1)GO TO 6
30600		P(L)=A
30700	C SAME POS.
30800		GO TO 1
30900	6	IF(P(L).GT.A)GO TO 1
31000	C FIND ITEM FURTHEST TO LEFT
31100		A=P(L)
31200		K=L
31300	1	CONTINUE
31400	10	IF(K.EQ.KK)GO TO 3
31500		B=PR(K)
31600		C=PL(K)
31700		D=PS(K)
31800		DO 4 L=K,KK+1,-1
31900	C SHUFFLE ARRAYS
32000		LL=L-1
32100		P(L)=P(LL)
32200		PL(L)=PL(LL)
32300		PR(L)=PR(LL)
32400	4	PS(L)=PS(LL)
32500	11	P(KK)=A
32600		PR(KK)=B
32700		PL(KK)=C
32800		PS(KK)=D
32900	3	K=KK+1
33000		IF(K.LE.N)GO TO 2
33100	
33200	C NOW COLLECT ALL SPACE IN PL ARRAY
33300		DO 20 K=2,N+1
33400		L=K-1
33500		IF(PS(K).NE.PS(L))GO TO 21
33600	C SAME STAFF?
33700		GO TO 23
33800	21	L=K-2
33900	22	IF(PS(L).EQ.PS(K))GO TO 23
34000		L=L-1
34100		IF(L.GT.0)GO TO 22
34200		GO TO 20
34300	23	PL(K)=PL(K)+PR(L)
34400	C FOUND PREVIOUS ITEM ON SAME STAFF.
34500	20	CONTINUE
34600	
34700	C NOW STORE POS  OF EACH PREV. ITEM ON SAME STAFF IN PR ARRAY.
34800		DO 40 K=2,N+1
34900		L=K-1
35000		IF(PS(K).NE.PS(L))GO TO 41
35100	C SAME STAFF?
35200		GO TO 43
35300	41	L=K-2
35400	42	IF(PS(L).EQ.PS(K))GO TO 43
35500		L=L-1
35600		IF(L.GT.0)GO TO 42
35700		PR(K)=R4
35800	C FAR LEFT POS. OF JUST. RANGE GOES INTO PS
35900		GO TO 40
36000	43	PR(K)=P(L)
36100	C FOUND PREVIOUS ITEM ON SAME STAFF.
36200	C STORE POS. OF PREVIOUS ITEM IN PR ARRAY.
36300	40	CONTINUE
36400		PR(1)=R4
36500	
36600	C NOW GET RID OF UNNEEDED DATA
36700		L=2
36800	30	LL=L-1
36900		IF(P(L).NE.P(LL))GO TO 36
37000	C NOW 2 ITEMS IN SAME POS. ON DIFF. STAVES
37100		IF(PR(L).EQ.PR(LL))GO TO 34
37200	C JUMP IF POS. OF PREV. ITEM IS SAME IN BOTH CASES.
37300		A=P(L)-PR(L)-PL(L)
37400		B=P(LL)-PR(LL)-PL(LL)
37500	C A,B = EXCESS SPACE AVAILABLE., KEEP THE ONE WITH THE LEAST.
37600		IF(B.GT.A)L=L-1
37700		GO TO 35
37800	34	IF(PL(L).GT.PL(LL))PL(LL)=PL(L)
37900	C EXCHANGE IF NEEDED SPACE HERE IS < PREVIOUS NEEDED
38000	35	N=N-1
38100	C DECREMENT COUNTER
38200	33	DO 32 K=L,N
38300	C CONTRACT ARRAY
38400		M=K+1
38500		PL(K)=PL(M)
38600		PR(K)=PR(M)
38700	32	P(K)=P(M)
38800		GO TO 9
38900	36	L=L+1
39000	9	IF(L.LE.N)GO TO 30
39100	 
39200	100	DO 101 K=1,N
39300	101	PS(K)=P(K)
39400	C PS WILL HOLD SHIFTED POINTS
39500		DO 50 J=1,50
39600	C "ACCORDEAN" LOOP - USUALLY EXITS WELL BEFORE 50
39700		Y=0
39800		DO 51 K=2,N
39900		A=PS(K)-PR(K)-PL(K)
40000	C NEG. MOVE REQUIREMENT
40100		IF(A.GE.-0.1)GO TO 51
40200	C SKIP IF ENOUGH SPACE
40300		Y=PS(K)
40400	C SHIFT ALL POINTS FOUND FROM HERE TO FAR RIGHT
40500		DO 52 L=K,N
40600		PS(L)=PS(L)-A
40700	52	IF(PR(L).GE.Y)PR(L)=PR(L)-A
40800		IF(PR(K).EQ.PS(K-1))GO TO 51
40900	C JUMP IF PREVIOUS ITEM ON SAME STAFF
41000	C NOW SHIFT OTHER STAVES' ITEMS FOUND TO LEFT
41100		Z=PR(K)
41200	C LOOK IN AREA BOUNDED BY Z AND Y
41300		F=(Y-Z-A)/(Y-Z)
41400	C SPACING FACTOR
41500		DO 53 L=1,N
41600		B=PS(L)
41700		IF(B.LT.Z.OR.B.GT.Y)GO TO 54
41800	C FOUND A POINT TO SHIFT
41900		B=B-Z
42000	C ACTUAL SPACE FROM LEFT LIMIT
42100		PS(L)=Z+B*F
42200	C LEFT LIMIT+SPACE*FACTOR
42300	54	B=PR(L)
42400		IF(B.LT.Z.OR.B.GT.Y)GO TO 53
42500		B=B-Z
42600		PR(L)=Z+B*F
42700	53	CONTINUE
42800	51	CONTINUE
42900		IF(PS(N).LE.R5)GO TO 203
43000	C MORE THAN ENOUGH SPACE EXISTS
43100	        IF(Y.EQ.0)GO TO 203
43200	C JUMP OUT IF NO POINTS MOVED
43300	      F=(R5-R4)/(PS(N)-R4)
43400	C FACTOR TO SHIFT ALL BACK WITHIN ORIGINAL LIMITS
43500	        DO 56 K=1,N
43600	        PS(K)=R4+(PS(K)-R4)*F
43700	56      PR(K)=R4+(PR(K)-R4)*F
43800	50    CONTINUE
43900	
44000	CQ NEXT WAS ATTEMPT TO REPLACE "ACCORDEAN" SYSTEM 3/83  (LABELS 101+1→50)
44100	CQ	GO TO 203
44200	CQ        DIMENSION PSX(300),PRR(300),PG(300)
44300	C GET NUM OF STAFF TO JUSTIFY
44400	CQ        DO 60 K=1,N
44500	C SAVE ALL DATA
44600	CQ        PSX(K)=PS(K)
44700	CQ        PRR(K)=PR(K)
44800	CQ60      PG(K)=PS(K)-PR(K)-PL(K)
44900	C PG ARRAY HAS VALUE OF ALL GAPS.
45000	CQ        J=0
45100	CQ61      T=0
45200	C T=TOTAL GAP SPACE AVAILABLE
45300	CQ        DO 62 K=1,N
45400	CQ        IF(PG(K).LE.0)GO TO 62
45500	C SKIP IF NO GAP IN FRONT OF THIS ITEM
45600	CQ        A=PR(K)
45700	C POS. OF PREVIOUS ITEM ON THAT STAFF
45800	CQ        B=PS(K)
45900	C POS OF THIS ITEM
46000	CQ        G=PG(K)
46100	C ADJUSTED GAP SIZE AVAILABLE
46200	CQ	IF(R2.LT.RJLP)GO TO 66
46300	CQ        GG=0
46400	CQ        DO 63 L=K+1,N
46500	C CHECK FOR K+1 > N
46600	CQ        IF(PS(L).LE.A.OR.PR(L).GE.B)GO TO 63
46700	C JUMP IF ITEM IS TO LEFT OF ITEM K OR PREV. IS TO RIGHT
46800	CQ        IF(PG(L).LE.0)GO TO 63
46900	C JUMP IF NO GAP HERE
47000	CQ        GG=PG(L)
47100	CQ	IF(PS(L)-GG.LT.PS(L-1))GG=PS(L)-PS(L-1)
47200	C GAP CAN BE NO GREATER THAN DIST TO PREV. ITEM ON OTHER STAFF
47300	CQ        IF(GG.LT.G)G=GG
47400	C FIND SMALLEST GAP
47500	CQ63      CONTINUE
47600	CQ        IF(GG.EQ.0)GO TO 62
47700	C JUMP IF NO GAPS WITHIN PROPER BOUNDS ARE FOUND
47800	CQ66      T=T+G
47900	C ADD UP TOTAL GAP SPACE
48000	CQ        DO 64 L=K,N
48100	C NOW SHIFT ALL ITEMS TO LEFT TO FILL IN SMALLEST GAP
48200	CQ        PS(L)=PS(L)-G
48300	CQ        IF(PR(L).GE.B)GO TO 65
48400	C SKIP IF PREV. ITEM IS OUT OF BOUNDS TO RIGHT
48500	CQ        PG(L)=PG(L)-G
48600	C DECREASE THE GAP SIZES
48700	CQ        GO TO 64
48800	CQ65      PR(L)=PR(L)-G
48900	C MOVE BACK POS. OF PREV. ITEM IF IN BOUNDS
49000	CQ64      CONTINUE
49100	CQ62      CONTINUE
49200	CQ        IF(J.NE.0)GO TO 203
49300	C J=-1 SECOND TIME THROUGH LOOP.
49400	CQ        IF(T.EQ.0)GO TO 70
49500	C JUMP IF NO FREE SPACE WAS FOUND
49600	CQ        X=(PSX(N)-R5)/T
49700	C EXTRA SPACE REDUCTION FACTOR
49800	CQ        IF(X.LT.1.0)GO TO 71
49900	C JUMP IF NOT ENOUGH ROOM WAS FOUND, USE PS AS IS.
50000	CQ70      X=(R5-R4)/(PS(N)-R4)
50100	C SHIFT ALL POINTS BY THIS FACTOR
50200	CQ        DO 75 L=1,N
50300	CQ        PS(L)=R4+(PS(L)-R4)*X
50400	CQ75      PR(L)=R4+(PR(L)-R4)*X
50500	CQ        GO TO 203
50600	CQ71      DO 72 L=1,N
50700	C GET BACK ORIGINAL DATA AND GO THRU LOOP AGAIN WITH FACTOR
50800	CQ        PS(L)=PSX(L)
50900	CQ        PR(L)=PRR(L)
51000	CQ72      PG(L)=(PS(L)-PR(L)-PL(L))*X
51100	CQ        J=-1
51200	CQ        GO TO 61
51300	
51400	C NOW PS(1) SHOULD BE >=R4, PS(N)<=R5.
51500	203	CALL MOVIT(RN,NO,R5,2000.0,1000.0,0.0)
51600	C MOVE ANYTHING TO RIGHT OF JUSTIFY AREA FAR TO RIGHT.
51700	CC CAN'T USE DO LOOP, FAIL PROG. WIPES OUT AC15.	DO 206 K=1,N
51800		CALL MOVIT(RN,NO,R4,R5,500.0,0.0)
51900	C NOW MOVE JUSTIFY AREA 500 TO RIGHT. LEAVES ROOM FOR EXPANSION, CONTRACTION.
52000		K=2
52100		L=1
52200	C A= AMOUNT MOVED LEFT OR RIGHT.
52300	206	CALL MOVIT(RN,NO,P(L)+500.0,P(K)+500.0,PS(L),PS(K))
52400	C MOVE OLD RANGE INTO NEW RANGE (AND SHIFT BACK 500)
52500		L=K
52600		K=K+1
52700		IF(K.LE.N)GO TO 206
52800		CALL MOVIT(RN,NO,R5+1000.0,3000.0,-1000.0,0.0)
52900	C MOVE BACK THINGS TO RIGHT OF JUSTIFY AREA.  NOW ALL DONE.
53000	300	END